home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)TA / (A)TAR.ADF / t < prev    next >
Text File  |  1988-09-30  |  35KB  |  1,237 lines
  1.   ON BREAK GOSUB quit:BREAK ON
  2.   WINDOW CLOSE 1
  3.   WINDOW 2,"STAR TREK AMIGA",,20,-1
  4.  
  5.   DEFINT a-z
  6.   FOR i=1 TO 4:MENU i,0,0,"":NEXT
  7.   OPTION BASE 1
  8.   IF NOT debug THEN GOSUB intro1
  9.   DEF FNd(d)=SQR((klingon(i,1)-shipx)^2+(klingon(i,2)-shipy)^2)
  10.   DIM galaxy(8,8),record(8,8),quadrant(8,8)
  11.   DIM dx(9),dy(9),moves(10,2),klingon(3,3)
  12.   DIM damage!(8),damage$(8)
  13.   DIM saw(256),chop(256),boom(256)
  14.   DIM eprs(35),klon(35),home(35),torp(35),star(35),bng1(35),bng2(35),bng3(35)
  15.   DIM rgb(4,3)
  16.   temp&=PEEKL(PEEKL(PEEKL(WINDOW(7)+46)+48)+4)
  17.   FOR i=1 TO 4
  18.     msg$=RIGHT$("00"+HEX$(PEEKW(temp&+2*i)),3)
  19.     FOR j=1 TO 3:rgb(i,j)=VAL("&h"+MID$(msg$,j,1)):NEXT
  20.   NEXT
  21.   PALETTE 0, 2/16, 4/16, 9/16
  22.   PALETTE 1,15/16,15/16,15/16
  23.   PALETTE 2, 0/16, 0/16, 2/16
  24.   PALETTE 3,15/16, 8/16, 0/16
  25.   enterprise=30000
  26.   fullenergy=3000
  27.   fullphoton=10
  28.   dx(1)= 1:dy(1)= 0
  29.   dx(2)= 1:dy(2)=-1
  30.   dx(3)= 0:dy(3)=-1
  31.   dx(4)=-1:dy(4)=-1
  32.   dx(5)=-1:dy(5)= 0
  33.   dx(6)=-1:dy(6)= 1
  34.   dx(7)= 0:dy(7)= 1
  35.   dx(8)= 1:dy(8)= 1
  36.   dx(9)= 1:dy(9)= 0
  37.   FOR i=1 TO 256
  38.     saw(i)=i-129
  39.     IF i<129 THEN chop(i)=127 ELSE chop(i)=-128
  40.     boom(i)=255*RND-128
  41.   NEXT
  42.   WAVE 2,saw
  43.   WAVE 3,chop
  44.   RESTORE quit
  45.   OPEN "grfx" FOR INPUT AS #1
  46.     FOR i=1 TO 35:INPUT #1,eprs(i):NEXT
  47.     FOR i=1 TO 35:INPUT #1,klon(i):NEXT
  48.     FOR i=1 TO 35:INPUT #1,home(i):NEXT
  49.     FOR i=1 TO 35:INPUT #1,torp(i):NEXT
  50.     FOR i=1 TO 35:INPUT #1,star(i):NEXT
  51.     FOR i=1 TO 35:INPUT #1,bng1(i):NEXT
  52.     FOR i=1 TO 35:INPUT #1,bng2(i):NEXT
  53.     FOR i=1 TO 35:INPUT #1,bng3(i):NEXT
  54.   CLOSE #1
  55.   FOR i=1 TO 8:READ device$(i):NEXT
  56.   command$="NAVSRSLRSPHATORSHIDAMCOMRESFIX"
  57.   command2$="GALREGHISBASKLIDIR"
  58.   quad1$="Antares    Rigel      Procyon    Vega       "
  59.   quad1$=quad1$+"Canopus    Altair     SagittariusPollux     "
  60.   quad2$="Sirius    Deneb     Capella   Betelgeuse"
  61.   quad2$=quad2$+"Aldebaran Regulus   Arcturus  Spica     "
  62. begin:
  63.   IF NOT debug THEN GOSUB intro2
  64.   RANDOMIZE TIMER
  65.   thisdate!=100*INT(20*RND+20)
  66.   startdate=thisdate!
  67.   enddate=INT(10*RND)+25
  68.   energy=fullenergy
  69.   photon=fullphoton
  70.   quadx=INT(8*RND)+1
  71.   quady=INT(8*RND)+1
  72.   shipx=INT(8*RND)+1
  73.   shipy=INT(8*RND)+1
  74.   docked=0
  75.   shields=0
  76.   FOR i=1 TO 8:damage!(i)=0:NEXT
  77.   totalbases=0
  78.   totalklingons=0
  79.   FOR i=1 TO 8
  80.     FOR j=1 TO 8
  81.       klingons=-(RND>.8)-(RND>.8)-(RND>.8)
  82.       totalklingons=totalklingons+klingons
  83.       IF RND>.96 THEN starbases=1:totalbases=totalbases+1 ELSE starbases=0
  84.       galaxy(i,j)=100*klingons+10*starbases+INT(8*RND)+1
  85.       record(i,j)=0
  86.     NEXT
  87.   NEXT
  88.   IF totalklingons>enddate THEN enddate=totalklingons+1
  89.   IF totalbases=0 THEN
  90.     IF galaxy(quadx,quady)<200 THEN
  91.       galaxy(quadx,quady)=galaxy(quadx,quady)+100
  92.       totalklingons=totalklingons+1
  93.     END IF
  94.     totalbases=1
  95.     galaxy(quadx,quady)=galaxy(quadx,quady)+10
  96.     quadx=INT(8*RND)+1
  97.     quady=INT(8*RND)+1
  98.   END IF
  99.   numshot=totalklingons
  100.   IF NOT debug THEN GOSUB intro3
  101.   GOSUB drawscreen
  102.   GOSUB newquadrant
  103.  
  104. dock:
  105.   docked=0
  106.   FOR i=shipx-1 TO shipx+1
  107.     FOR j=shipy-1 TO shipy+1
  108.       IF i>0 AND i<9 AND j>0 AND j<9 THEN
  109.         IF quadrant(i,j)=1 THEN
  110.           i=shipx+1
  111.           j=shipy+1
  112.           docked=-1
  113.           energy=fullenergy
  114.           photon=fullphoton
  115.           shields=0
  116.           CALL prtmsg ("Shields dropped for docking, please remember to raise them, sir!")
  117.         END IF
  118.       END IF
  119.     NEXT
  120.   NEXT
  121.  
  122. doinfo:
  123.   IF shields+energy<=10 OR (energy<=10 AND damage!(7)<>0) THEN
  124.     CALL prtmsg("*** FATAL ERROR ***"):delay 3
  125.     GOSUB redalert
  126.     CALL prtmsg("You've just stranded your ship in space."):delay 4
  127.     CALL prtmsg("You have insufficient maneuvering energy..."):delay 3
  128.     CALL prtmsg("...and shield control is incapable of cross-circuiting to engine room!!"):delay 3
  129.     CALL prtmsg("It is stardate"+STR$(10*INT(thisdate!/10))+".  The Enterprise is gone."):delay 3
  130.     GOTO newgame
  131.   END IF
  132.   COLOR 1,0
  133.   LOCATE 3,17:PRINT USING "####.##";thisdate!
  134.   LOCATE 4,17:PRINT USING "####.##";enddate+startdate-thisdate!
  135.   LOCATE 5,17:PRINT USING "####";totalbases
  136.   LOCATE 6,17
  137.   IF klingons>0 THEN
  138.     COLOR 2,3:PRINT "  RED  "
  139.   ELSEIF energy<fullenergy/10 THEN
  140.     COLOR 3:PRINT "YELLOW "
  141.   ELSE
  142.     PRINT " GREEN "
  143.   END IF
  144.   COLOR 1,0
  145.   LOCATE 7,17:PRINT quadx","quady
  146.   LOCATE 8,17:PRINT shipx","shipy
  147.   LOCATE 9,19:PRINT USING "##";photon
  148.   LOCATE 10,17:PRINT USING "####";energy+shields
  149.   LOCATE 11,2
  150.   IF shields<200 AND klingons>0 THEN
  151.     PRINT "  Shields LOW: ";
  152.   ELSE
  153.     PRINT "      Shields: ";
  154.   END IF
  155.   PRINT USING "####";shields
  156.   LOCATE 12,18:PRINT USING "###";totalklingons
  157.   IF klingons>0 THEN GOSUB redalert
  158.   CALL zoom(194,103,400,111,2)
  159.   COLOR 3,2:LOCATE 14,28:PRINT "Command Please:  ___"
  160.   msg$="___"
  161. mainloop:
  162.   i=15
  163.   key$=""
  164.   WHILE key$=""
  165.     key$=UCASE$(INKEY$)
  166.     IF i>600 THEN
  167.       LINE (i,10)-STEP(9,0),0
  168.       i=15
  169.       thisdate!=thisdate!+.1
  170.       COLOR 1,0
  171.       LOCATE 3,17:PRINT USING "####.##";thisdate!
  172.       LOCATE 4,17:PRINT USING "####.##";enddate+startdate-thisdate!
  173.     ELSE
  174.       i=i+5
  175.       LINE (i-5,10)-STEP(4,0),0
  176.       LINE (i,10)-STEP(4,0),1
  177.       IF enddate+startdate=INT(thisdate!) THEN
  178.         CALL prtmsg("You have run out of time for completing you mission."):delay 3
  179.         CALL prtmsg("The Klingons have just overrun Federation Headquarters!!!"):delay 3
  180.         CALL prtmsg("All is lost."):delay 3
  181.         GOTO newgame
  182.       END IF
  183.     END IF
  184.   WEND
  185.   LINE (i,10)-STEP(9,0),0
  186.   IF key$=CHR$(27) THEN
  187.     GOTO quit
  188.   ELSEIF key$=CHR$(8) THEN
  189.     msg$=RIGHT$("___"+LEFT$(msg$,2),3)
  190.   ELSEIF key$=CHR$(13) OR key$=CHR$(139) THEN
  191.     WINDOW 3,"Command Summary-Any Key to Close",(185,50)-(185+256,50+80),0,-1
  192.     COLOR 3,2:CLS
  193.     PRINT " NAV = set course"
  194.     PRINT " SRS = short range sensor scan"
  195.     PRINT " LRS = long range sensor scan"
  196.     PRINT " PHA = fire phasers"
  197.     PRINT " TOR = fire photon torpedoes"
  198.     PRINT " SHI = raise (or lower) shields"
  199.     PRINT " DAM = damage control reports"
  200.     PRINT " COM = call on library-computer"
  201.     PRINT " RES = resign your command"
  202.     PRINT " FIX = fix and redraw screen";
  203.     COLOR 1,0
  204.     CALL whoa
  205.     msg$="___"
  206.     WINDOW CLOSE 3
  207.   ELSEIF INSTR(command$,key$)>0 THEN
  208.     msg$=RIGHT$("___"+msg$+key$,3)
  209.   END IF
  210.   COLOR 3,2:LOCATE 14,45:PRINT msg$
  211.   temp=0
  212.   FOR i=0 TO 9
  213.     IF msg$=MID$(command$,3*i+1,3) THEN temp=i+1:i=9
  214.   NEXT
  215.   IF temp=0 THEN mainloop
  216.   ON z GOSUB znav,zlrs,zpha,ztor,zshi,zdam:z=0
  217.   CALL zoom(194,103,400,111,0)
  218.   ON temp GOTO nav,srs,lrs,pha,tor,shi,dam,com,res,cle
  219.  
  220. znav:
  221.   CALL zoom(408,119,627,135,0)
  222.   RETURN
  223. nav:
  224.   CALL zoom(408,119,627,135,2):z=1
  225.   COLOR 1,2:LOCATE 16,53:PRINT "Enter course (1-9) ->":ding
  226.   course!=0
  227.   WHILE course!<1 OR course!=>9
  228.     CALL navnum(75,16,course!)
  229.     IF course!<1 OR course!=>9 THEN CALL prtmsg ("Lt. Sulu reports: 'Incorrect course data, sir!'")
  230.   WEND
  231.   IF damage!(1)<0 THEN a$=".2)" ELSE a$="8) "
  232.   COLOR 1,2:LOCATE 17,53:PRINT "Warp factor  (0-"+a$+"->":ding
  233.   warp!=9
  234.   WHILE warp!=>9
  235.     CALL navnum(75,17,warp!)
  236.   WEND
  237.   IF warp!=0 THEN doinfo
  238.   IF damage!(1)<0 AND warp!>.2 THEN
  239.     CALL prtmsg("Warp engines are damaged. Maximum speed = warp 0.2")
  240.     GOTO doinfo
  241.   END IF
  242.   IF warp!=>8 THEN
  243.     CALL prtmsg("Chief Engineer Scott reports: The engines won't take warp"+STR$(warp!)+"!"):delay 3
  244.     GOTO doinfo
  245.   END IF
  246.   navnrgy=CINT(8*warp!)             'navnrgy=energy used by navigation
  247.   IF energy-navnrgy<0 THEN
  248.     CALL prtmsg("Engineering reports: Insufficient energy for maneuvering at warp"+STR$(warp!)+"!")
  249.     IF shields=>navnrgy-energy AND damage!(7)=>0 THEN
  250.       CALL prtmsg("Control room acknowledges:"+STR$(shields)+" UNITS OF ENERGY TO SHIELDS.")
  251.     END IF
  252.     GOTO doinfo
  253.   END IF
  254.   fix1=0
  255.   FOR i=1 TO 8
  256.     IF damage!(i)>=0 THEN
  257.       damage!(i)=0
  258.     ELSE
  259.       damage!(i)=damage!(i)-(warp!=>1)-warp!*(warp!<1)
  260.       IF damage!(i)<0 THEN
  261.         IF damage!(i)>-.1 THEN damage!(i)=-.1
  262.       ELSEIF NOT fix1 THEN
  263.         fix1=-1
  264.         CALL prtmsg ("DAMAGE CONTROL REPORT: "+device$(i)+" Repair completed."):delay 3
  265.       END IF
  266.     END IF
  267.   NEXT
  268.   IF RND<.2 THEN
  269.     rnd1=INT(8*RND)+1
  270.     IF RND<.6 THEN
  271.       damage!(rnd1)=damage!(rnd1)-5*RND+1
  272.       CALL prtmsg ("DAMAGE CONTROL REPORT: "+device$(rnd1)+" damaged"):delay 3
  273.       IF rnd1=2 THEN GOSUB zsrs:srsflag=0
  274.     ELSE
  275.       damage!(rnd1)=damage!(rnd1)+3*RND+1
  276.       CALL prtmsg ("DAMAGE CONTROL REPORT: "+device$(rnd1)+" State of repair improved."):delay 3
  277.     END IF
  278.   END IF
  279.   quadrant(shipx,shipy)=0
  280.   newx=shipx
  281.   newy=shipy
  282.   x!=newx
  283.   y!=newy
  284.   temp=INT(course!)
  285.   crsx!=dx(temp)+(dx(temp+1)-dx(temp))*(course!-temp)
  286.   crsy!=dy(temp)+(dy(temp+1)-dy(temp))*(course!-temp)
  287.   FOR temp=1 TO navnrgy                'begin moving starship
  288.     oldx=newx
  289.     oldy=newy
  290.     x!=x!+crsx!
  291.     y!=y!+crsy!
  292.     newx=CINT(x!)
  293.     newy=CINT(y!)
  294.     IF newx>0 AND newx<9 AND newy>0 AND newy<9 THEN
  295.       IF quadrant(newx,newy)=0 THEN
  296.         IF srsflag THEN
  297.           LINE (24*oldx+408,8*oldy+24)-STEP(23,7),2,bf
  298.           PUT (24*newx+408,8*newy+24),eprs,PSET
  299.         END IF
  300.       ELSE
  301.         CALL prtmsg ("Warp engines shut down at sect"+STR$(shipx)+","+STR$(shipy)+" due to bad navigation."):delay 3
  302.         temp=navnrgy
  303.         newx=oldx
  304.         newy=oldy
  305.       END IF
  306.     ELSE
  307.       IF (newx<1 AND quadx=1) OR (newx>8 AND quadx=8) OR (newy<1 AND quady=1) OR (newy>8 AND quady=8) THEN
  308.         CALL prtmsg ("Lt. Uhura reports a message from Starfleet Command:"):delay 4
  309.         CALL prtmsg ("`Permission to attempt crossing of galactic perimeter is hereby *DENIED*!'"):delay 2
  310.         CALL prtmsg ("`You must shut down your engines!'"):delay 2
  311.         CALL prtmsg ("Chief Engineer Scott reports:"):delay 2
  312.         CALL prtmsg ("`Warp engines shut down at Sector"+STR$(oldx)+","+STR$(oldy)+" - Quadrant"+STR$(quadx)+","+STR$(quady)+"'"):delay 2
  313.         temp=navnrgy
  314.         newx=oldx
  315.         newy=oldy
  316.       ELSE
  317.         x!=x!-INT(x!)
  318.         y!=y!-INT(y!)
  319.         shipx=newx
  320.         shipy=newy
  321.         IF newx<1 THEN quadx=quadx-1:shipx=8
  322.         IF newx>8 THEN quadx=quadx+1:shipx=1
  323.         IF newy<1 THEN quady=quady-1:shipy=8
  324.         IF newy>8 THEN quady=quady+1:shipy=1
  325.         GOSUB newquadrant
  326.         quadrant(shipx,shipy)=0
  327.         newflag=-1
  328.         newx=shipx
  329.         newy=shipy
  330.         x!=newx+x!
  331.         y!=newy+y!
  332.       END IF
  333.     END IF
  334.   NEXT
  335.   shipx=newx
  336.   shipy=newy
  337.   quadrant(shipx,shipy)=enterprise
  338.   IF NOT newflag THEN GOSUB klingonfire
  339.   newflag=0
  340.   GOSUB moveklingons
  341.   energy=energy-navnrgy-10
  342.   IF energy<0 THEN
  343.     CALL prtmsg ("Shield control supplies energy to complete the maneuver.")
  344.     shields=shields+energy
  345.     energy=0
  346.     IF shields<0 THEN shields=0
  347.   END IF
  348.   thisdate!=thisdate!+warp!
  349.   IF thisdate!>startdate+enddate THEN
  350.     CALL prtmsg("Time has run out for your mission!"):delay 3
  351.     GOTO newgame
  352.   END IF
  353.   GOTO dock
  354.  
  355. zsrs:
  356.   CALL zoom(432,32,626,95,0)
  357.   RETURN
  358. srs:
  359.   srsflag=-1
  360.   GOSUB drawsrs
  361.   GOTO dock
  362. drawsrs:
  363.   IF damage!(2)<0 THEN
  364.     CALL prtmsg ("Short Range Sensors are disabled")
  365.     srsflag=0
  366.     GOSUB zsrs
  367.     GOTO doinfo
  368.   END IF
  369.   CALL zoom(432,32,626,95,2)
  370.   FOR i=1 TO 8
  371.     FOR j=1 TO 8
  372.       IF quadrant(i,j)<>0 THEN
  373.         IF quadrant(i,j)=2 THEN
  374.           PUT (24*i+408,8*j+24),star,PSET
  375.         ELSEIF quadrant(i,j)=enterprise THEN
  376.           PUT (24*i+408,8*j+24),eprs,PSET
  377.         ELSEIF quadrant(i,j)<0 THEN
  378.           PUT (24*i+408,8*j+24),klon,PSET
  379.         ELSE
  380.           PUT (24*i+408,8*j+24),home,PSET
  381.         END IF
  382.       END IF
  383.     NEXT
  384.   NEXT:ding
  385.   RETURN
  386.  
  387. zlrs:
  388.   CALL zoom(4,119,186,183,0)
  389.   RETURN
  390. lrs:
  391.   IF damage!(3)<0 THEN
  392.     CALL prtmsg("Long Range Sensors are inoperable")
  393.     GOTO doinfo
  394.   END IF
  395.   CALL zoom(4,119,186,183,1):z=2
  396.   COLOR 2,1:LOCATE 16,5:PRINT "Quadrant ";quadx;",";quady
  397.   COLOR 3,1
  398.   temp=1
  399.   FOR i=quady-1 TO quady+1
  400.     LINE (17,16*temp+114)-STEP(149,2),2,bf
  401.     LOCATE 16+temp*2,5
  402.     FOR j=quadx-1 TO quadx+1
  403.       LINE (48*(j-quadx+2)-31,16*temp+117)-STEP(5,13),2,bf
  404.       IF i>0 AND i<9 AND j>0 AND j<9 THEN
  405.         record(j,i)=galaxy(j,i)
  406.         PRINT RIGHT$(STR$(galaxy(j,i)+1000),3);
  407.       ELSE
  408.         PRINT "***";
  409.       END IF
  410.       PRINT SPC(3);
  411.     NEXT
  412.     LINE (48*(j-quadx+2)-31,16*temp+117)-STEP(5,13),2,bf
  413.     temp=temp+1
  414.   NEXT
  415.   LINE (17,178)-STEP(149,2),2,bf
  416.   CALL prtmsg("Storing Data in 'GALactic' memory, found in our computer banks.")
  417.   GOTO doinfo
  418.  
  419. zpha:
  420.   CALL zoom(194,152,400,159,0)
  421.   RETURN
  422. pha:
  423.   CALL zoom(194,152,400,159,2):z=3
  424.   IF damage!(4)<0 THEN
  425.     CALL prtmsg ("Phasers Inoperative")
  426.     GOTO doinfo
  427.   ELSEIF klingons<=0 THEN
  428.     GOTO noships
  429.   ELSEIF damage!(8)<0 THEN
  430.     CALL prtmsg ("Computer failure hampers accuracy"):delay 3
  431.   END IF
  432.   IF klingons>1 THEN plural$="s" ELSE plural$=""
  433.   COLOR 3,2
  434.   LOCATE 20,26:PRINT "Phasers locked on target"+plural$:ding:delay 2
  435.   LOCATE 20,26:PRINT USING "Energy available:    ####";energy:ding:delay 2
  436.   LOCATE 20,26:PRINT "Number units to fire:":ding
  437. phaloop:
  438.   tmp!=0:CALL navnum(47,20,tmp!)
  439.   IF tmp!<=0 THEN doinfo
  440.   IF tmp!>energy THEN phaloop
  441.   energy=energy-tmp!
  442.   GOSUB klingonfire
  443.   GOSUB phasersnd
  444.   IF damage!(7)<0 THEN tmp!=tmp!*RND
  445.   temp=INT(tmp!/klingons)
  446.   FOR i=1 TO 3
  447.     IF klingon(i,3)>0 THEN
  448.       hit!=INT((temp/FNd(0))*(RND+2))
  449.       IF hit!>.15*klingon(i,3) THEN
  450.         klingon(i,3)=klingon(i,3)-hit!
  451.         IF klingon(i,3)<0 THEN
  452.           CALL prtmsg (STR$(INT(hit!))+" unit hit on Klingon at sector"+STR$(klingon(i,1))+","+STR$(klingon(i,2))):delay 4
  453.           CALL prtmsg ("(Sensors show"+STR$(klingon(i,3))+" units remaining)"):delay 3
  454.         ELSE
  455.           IF srsflag THEN
  456.             CALL blast(24*klingon(i,1)+408,8*klingon(i,2)+24)
  457.           ELSE
  458.             CALL prtmsg("KLINGON DESTROYED!!!")
  459.           END IF
  460.           klingons=klingons-1
  461.           totalklingons=totalklingons-1
  462.           klingon(i,3)=0
  463.           quadrant(klingon(i,1),klingon(i,2))=0
  464.           galaxy(quadx,quady)=galaxy(quadx,quady)-100
  465.           record(quadx,quady)=galaxy(quadx,quady)
  466.         END IF
  467.       ELSE
  468.         CALL prtmsg("Sensors show no damage to enemy at "+STR$(klingon(i,1))+","+STR$(klingon(i,2))):delay 3
  469.       END IF
  470.     END IF
  471.   NEXT
  472.   IF totalklingons=0 THEN winner
  473.   GOSUB moveklingons
  474.   GOTO doinfo
  475.  
  476. ztor:
  477.   CALL zoom(194,176,400,183,0)
  478.   RETURN
  479. tor:
  480.   IF photon<=0 THEN
  481.     CALL prtmsg ("All photon torpedoes expended")
  482.     GOTO doinfo
  483.   ELSEIF damage!(5)<0 THEN
  484.     CALL prtmsg ("Photon tubes are not operational")
  485.     GOTO doinfo
  486.   END IF
  487.   CALL zoom(194,176,400,183,2):z=4
  488.   COLOR 1,2:LOCATE 23,26:PRINT "Enter course (1-9) :";:ding
  489.   course!=0
  490.   WHILE course!<1 OR course!=>9
  491.     CALL navnum(46,23,course!)
  492.     IF course!<1 OR course!=>9 THEN CALL prtmsg ("Ensign Chekov reports: `Incorrect course data, sir!'")
  493.   WEND
  494.   GOSUB klingonfire
  495.   energy=energy-2
  496.   photon=photon-1
  497.   x!=shipx
  498.   y!=shipy
  499.   temp=INT(course!)
  500.   crsx!=dx(temp)+(dx(temp+1)-dx(temp))*(course!-temp)
  501.   crsy!=dy(temp)+(dy(temp+1)-dy(temp))*(course!-temp)
  502. torpedoloop:
  503.   x!=x!+crsx!
  504.   y!=y!+crsy!
  505.   newx=CINT(x!)
  506.   newy=CINT(y!)
  507.   IF newx>0 AND newx<9 AND newy>0 AND newy<9 THEN
  508.     IF quadrant(newx,newy)=0 THEN
  509.       IF srsflag THEN PUT (24*newx+408,8*newy+24),torp,PSET:stall:stall
  510.     ELSEIF quadrant(newx,newy)=1 THEN
  511.       IF srsflag THEN
  512.         CALL blast(24*oldx+408,8*oldy+24)
  513.       ELSE
  514.         CALL prtmsg ("*** STARBASE DESTROYED ***"):delay 3
  515.       END IF
  516.       docked=0
  517.       quadrant(newx,newy)=0
  518.       starbases=starbases-1
  519.       totalbases=totalbases-1
  520.       IF totalbases=0 OR totalklingons<=thisdate!-startdate-enddate THEN
  521.         CALL prtmsg("THAT DOES IT, CAPTAIN!!  You are hereby relieved of command"):delay 3
  522.         CALL prtmsg("and sentenced to 99 stardates of forced hard labor on CYGNUS 12!!"):delay 3
  523.         GOTO newgame
  524.       ELSE
  525.         CALL prtmsg("Starfleet reviewing your record to consider court martial!"):delay 6
  526.         GOTO missed
  527.       END IF
  528.     ELSEIF quadrant(newx,newy)=2 THEN
  529.       IF srsflag THEN
  530.         CALL blast(24*newx+408,8*newy+24)
  531.         PUT (24*newx+408,8*newy+24),star,PSET
  532.       ELSE
  533.         CALL prtmsg ("Star at"+STR$(newx)+","+STR$(newy)+" absorbed Torpedo energy.")
  534.       END IF
  535.       GOTO missed
  536.     ELSEIF quadrant(newx,newy)<0 THEN
  537.       IF srsflag THEN
  538.         CALL blast(24*newx+408,8*newy+24)
  539.       ELSE
  540.         CALL prtmsg("KLINGON DESTROYED!!!")
  541.       END IF
  542.       quadrant(newx,newy)=0
  543.       i=1:WHILE klingon(i,1)<>newx OR klingon(i,2)<>newy:i=i+1:WEND
  544.       klingon(i,3)=0
  545.       klingons=klingons-1
  546.       totalklingons=totalklingons-1
  547.       IF totalklingons=0 THEN winner
  548.       galaxy(quadx,quady)=100*klingons+10*starbases+stars
  549.       record(quadx,quady)=galaxy(quadx,quady)
  550.       GOTO missed
  551.     END IF
  552.     IF srsflag AND quadrant(newx,newy)<>2 THEN LINE (24*newx+408,8*newy+24)-STEP(23,7),2,bf
  553.     GOTO torpedoloop
  554.   ELSE
  555.     CALL prtmsg ("Torpedo missed")
  556.   END IF
  557. missed:
  558.   GOSUB moveklingons
  559.   GOTO doinfo
  560.  
  561. zshi:
  562.   CALL zoom(194,127,400,135,0)
  563.   RETURN
  564. shi:
  565.   IF damage!(7)<0 THEN CALL prtmsg ("Shield control is inoperable"):GOTO doinfo
  566.   CALL zoom(194,127,400,135,2):z=5
  567.   COLOR 3,2
  568.   LOCATE 17,26:PRINT USING "Energy available  = ####";energy+shields:ding:delay 2
  569.   LOCATE 17,26:PRINT "Units to shields  =     ":ding
  570.   CALL navnum(46,17,tmp!)
  571.   temp=CINT(tmp!)
  572.   IF shields=temp THEN LOCATE 17,26:PRINT "Shields Unchanged       ":GOTO doinfo
  573.   IF temp=>energy+shields THEN
  574.     CALL prtmsg ("Shield Control reports 'Your request is invalid!'")
  575.     LOCATE 17,26:PRINT "Shields Unchanged       "
  576.     GOTO doinfo
  577.   END IF
  578.   energy=energy+shields-temp
  579.   shields=temp
  580.   CALL prtmsg ("Deflector Control Room: Shields now at"+STR$(shields)+" Units")
  581.   GOTO doinfo
  582.  
  583. zdam:
  584.   CALL zoom(408,152,625,183,0)
  585.   RETURN
  586. dam:
  587.   IF damage!(6)<0 THEN
  588.     CALL prtmsg ("Damage report not available!"):delay 2
  589.     IF docked THEN repairs ELSE doinfo
  590.   ELSE
  591.     GOTO daminfo
  592.   END IF
  593. repairs:
  594.   tmp!=0
  595.   FOR i=1 TO 8
  596.     IF damage!(i)<0 THEN tmp!=tmp!+1
  597.   NEXT
  598.   IF tmp!=0 THEN doinfo
  599.   tmp!=tmp!+RND/2
  600.   IF tmp!>=1 THEN tmp!=.9
  601.   CALL zoom(408,152,625,183,2)
  602.   COLOR 3,2
  603.   LOCATE 20,54:PRINT "Standing by for repairs"
  604.   LOCATE 21,54:PRINT "to your ship. Etimated"
  605.   LOCATE 22,54:PRINT USING "time to repair is: #.##";tmp!
  606.   LOCATE 23,56:PRINT "OK to proceed? (y/n)";
  607.   key$="":WHILE key$<>"Y" AND key$<>"N":key$=UCASE$(INKEY$):SLEEP:WEND
  608.   IF key$="N" THEN doinfo
  609.   FOR i=1 TO 8
  610.     IF damage!(i)<0 THEN damage!(i)=0
  611.   NEXT
  612.   thisdate!=thisdate!+tmp!+.1
  613.   CALL ding:delay 1
  614. daminfo:
  615.   CALL zoom(408,152,625,183,2):z=6
  616.   COLOR 3,2
  617.   LOCATE 20,53
  618.   PRINT USING "Engines##.##";damage!(1);
  619.   PRINT USING "  SRSnsrs##.##";damage!(2)
  620.   LOCATE 21,53
  621.   PRINT USING "LRSnsrs##.##";damage!(3);
  622.   PRINT USING "  PHAsers##.##";damage!(4)
  623.   LOCATE 22,53
  624.   PRINT USING "PHOtons##.##";damage!(5);
  625.   PRINT USING "  DAMctrl##.##";damage!(6)
  626.   LOCATE 23,53
  627.   PRINT USING "SHIctrl##.##";damage!(7);
  628.   PRINT USING "  COMputr##.##";damage!(8);:ding
  629.   IF docked THEN CALL delay(3):GOTO repairs
  630.   GOTO doinfo
  631.  
  632. res:
  633.   CALL prtmsg("There were"+STR$(totalklingons)+" Klingon battle cruisers left at the end of your mission."):delay 3
  634.   GOTO quit
  635.  
  636. com:
  637.   IF damage!(8)<0 THEN CALL prtmsg ("Computer Disabled"):GOTO doinfo
  638.   WINDOW 3,"Library/Computer",(219,65)-(411,121),0,-1
  639.   COLOR 2,1:CLS
  640.   PRINT "GAL = Galactic Record"
  641.   PRINT "REG = Galaxy Regions Map"
  642.   PRINT "HIS = History"
  643.   PRINT "BAS = Starbase Nav Data"
  644.   PRINT "KLI = Klingon Dir/Dist"
  645.   PRINT "DIR = Dir/Dist Calc"
  646.   PRINT "Computer On: ___";
  647.   msg$="___"
  648. comploop:
  649.   key$="":WHILE key$="":key$=UCASE$(INKEY$):SLEEP:WEND
  650.   IF key$=CHR$(8) THEN
  651.     msg$=RIGHT$("___"+LEFT$(msg$,2),3)
  652.   ELSEIF INSTR(command2$,key$)>0 THEN
  653.     msg$=RIGHT$("___"+msg$+key$,3)
  654.   END IF
  655.   LOCATE 7,14:PRINT msg$;
  656.   temp=0
  657.   FOR i=0 TO 5
  658.     IF msg$=MID$(command2$,3*i+1,3) THEN temp=i+1:i=9
  659.   NEXT
  660.   IF temp=0 THEN comploop
  661.   ON temp GOSUB gal,reg,his,bas,kli,dir
  662.   CALL whoa
  663.   WINDOW CLOSE 3
  664.   GOTO doinfo
  665.  
  666. gal:
  667.   WINDOW 3,"Computer record of galaxy:",(123,77)-(507,149),0,-1
  668.   COLOR 3,2:CLS
  669.   COLOR 1:PRINT "   1     2     3     4     5     6     7     8"
  670.   FOR j=1 TO 8
  671.     COLOR 1:PRINT USING "# ";j;
  672.     FOR i=1 TO 8
  673.       IF record(i,j)=0 THEN
  674.         COLOR 0:PRINT"***   ";
  675.       ELSE
  676.         IF i=quadx AND j=quady THEN COLOR 1 ELSE COLOR 3
  677.         PRINT RIGHT$(STR$(record(i,j)+1000)+"   ",6);
  678.       END IF
  679.     NEXT
  680.     IF j<8 THEN PRINT
  681.   NEXT
  682.   RETURN
  683.  
  684. reg:
  685.   WINDOW 3,"THE GALAXY:",(211,57)-(419,129),0,-1
  686.   COLOR 3,2:CLS
  687.   PRINT " 1  2  3  4    1  2  3  4"
  688.   regionflag=0
  689.   FOR i=1 TO 8
  690.     PRINT USING "# ";i;
  691.     CALL quadrantname(1,i)
  692.     PRINT msg$;
  693.     CALL quadrantname(5,i)
  694.     PRINT TAB(17)msg$;
  695.     IF i<8 THEN PRINT
  696.   NEXT
  697.   RETURN
  698.  
  699. his:
  700.   WINDOW 3,"History of this game.",(115,50)-(515,138),0,-1
  701.   COLOR 3,2:CLS
  702.   PRINT TAB(11)"Original program by Dave Ahl"
  703.   PRINT TAB(17)"Modifications by"
  704.   PRINT "Bob & Sharon Fritz, Mike Stafford, and Jim Buzonik"
  705.   PRINT TAB(9)"AMIGA VERSION CONVERTED FROM IBM"
  706.   PRINT TAB(3)"by Phil Martinez (Phelan Gee) V1.5 08-16-88"
  707.   PRINT TAB(4)"This is a major re-write of that version."
  708.   PRINT TAB(3)"I couldn't run Phil's version on my 512K, so"
  709.   PRINT TAB(7)"I was working blind in writing this."
  710.   PRINT " Address comments, complaints, bugs, etc. to me:"
  711.   PRINT TAB(10)"john everett (PLINK ID OHS303)"
  712.   PRINT  TAB(10)"321 Hodges, Memphis, TN  38111";
  713.   RETURN
  714.  
  715. bas:
  716.   WINDOW 3,"From ENTERPRISE to Starbase:",(195,96)-(435,104),0,-1
  717.   COLOR 3,2:CLS
  718.   IF starbases=0 THEN PRINT "No starbases in this quadrant.";:RETURN
  719.   FOR i=1 TO 8:FOR j=1 TO 8
  720.     IF quadrant(j,i)=1 THEN newx=j:newy=i:j=8:i=8
  721.   NEXT:NEXT
  722.   CALL getcourse(shipx,shipy,newx,newy)
  723.   PRINT USING "  Course=#.##  ";course!;
  724.   PRINT USING "Distance=#.##";x!;
  725.   RETURN
  726.  
  727. kli:
  728.   WINDOW 3,"From ENTERPRISE to Klingon Cruisers:",(171,96)-(459,104),0,-1
  729.   COLOR 3,2:CLS
  730.   IF klingons=0 THEN PRINT "No klingons in this quadrant.";:RETURN
  731.   FOR temp=1 TO 3
  732.     IF klingon(temp,3)>0 THEN
  733.       CALL getcourse(shipx,shipy,klingon(temp,1),klingon(temp,2))
  734.       PRINT USING "Course=#.## ";course!;
  735.     END IF
  736.   NEXT
  737.   RETURN
  738.  
  739. dir:
  740.   WINDOW 3,"Direction/Distance Calculator",(205,96)-(455,112),0,-1
  741.   COLOR 3,2:CLS
  742. loop:
  743.   PRINT "Start x=   y=     End x=   y= "
  744.   COLOR 1
  745.   LOCATE 1,9:PRINT "_";:CALL digit(oldx):LOCATE 1,9:PRINT USING "#";oldx
  746.   LOCATE 1,14:PRINT "_";:CALL digit(oldy):LOCATE 1,14:PRINT USING "#";oldy
  747.   LOCATE 1,25:PRINT "_";:CALL digit(newx):LOCATE 1,25:PRINT USING "#";newx
  748.   LOCATE 1,30:PRINT "_";:CALL digit(newy):LOCATE 1,30:PRINT USING "#";newy
  749.   CALL getcourse(oldx,oldy,newx,newy)
  750.   PRINT USING "  Course=#.##";course!;
  751.   PRINT USING "   Distance=#.##";x!;
  752.   RETURN
  753.  
  754. moveklingons:
  755.   FOR i=1 TO klingons
  756.     IF klingon(i,3)<>0 THEN
  757.       FOR temp=1 TO 3
  758.         GOSUB findspot
  759.         IF ABS(rnd1-klingon(i,1))<=1 AND ABS(rnd2-klingon(i,2))<=1 THEN
  760.           IF srsflag THEN LINE (24*klingon(i,1)+408,8*klingon(i,2)+24)-STEP(23,7),2,bf
  761.           quadrant(klingon(i,1),klingon(i,2))=0
  762.           quadrant(rnd1,rnd2)=-1
  763.           klingon(i,1)=rnd1
  764.           klingon(i,2)=rnd2
  765.           IF srsflag THEN PUT (24*klingon(i,1)+408,8*klingon(i,2)+24),klon,PSET
  766.         END IF
  767.       NEXT
  768.     END IF
  769.   NEXT
  770.   RETURN
  771.  
  772. klingonfire:
  773.   IF klingons=0 THEN RETURN
  774.   IF docked THEN CALL prtmsg ("Starbase shields protect the ENTERPRISE"):delay 3:RETURN
  775.   temp=0
  776.   FOR i=1 TO 3
  777.     IF klingon(i,3)>0 THEN
  778.       temp=temp+INT((klingon(i,3)/FNd(1))*(RND+1))
  779.       shields=shields-temp
  780.       energy=energy-temp
  781.     END IF
  782.   NEXT
  783.   IF temp=0 THEN RETURN
  784.   ON z GOSUB znav,zlrs,zpha,ztor,zdam,zcom
  785.   z=0:zoom 408,152,625,183,2:z=6
  786.   LOCATE 20,57:PRINT "ENTERPRISE HIT !!!"
  787.   GOSUB alarmsnd
  788.   LOCATE 21,53:PRINT USING "### unit hit on ENTERPRISE";temp
  789.   IF shields<=0 THEN
  790.     GOSUB alarmsnd
  791.     CALL prtmsg("The Enterprise has been destroyed by enemy laser fire."):delay 5
  792.     GOTO newgame
  793.   END IF
  794.   LOCATE 22,53:PRINT USING "Shields down to #### units";shields
  795.   IF temp=>20 AND RND<.6 AND temp/shields>.02 THEN
  796.     rnd1=INT(8*RND)+1
  797.     damage!(rnd1)=damage!(rnd1)-temp/shields-.5*RND
  798.     LOCATE 23,53:PRINT device$(rnd1)+" damaged!";
  799.     IF rnd1=2 THEN GOSUB zsrs:srsflag=0
  800.   END IF
  801.   RETURN
  802.  
  803. noships:
  804.   CALL prtmsg ("Science Officer Spock reports: `Sensors show no enemy ships in this quadrant'")
  805.   GOTO doinfo
  806.  
  807. newquadrant:
  808.   klingons=0
  809.   starbases=0
  810.   stars=0
  811.   record(quadx,quady)=galaxy(quadx,quady)
  812.   IF quadx>0 AND quadx<9 AND quady>0 AND quady<9 THEN
  813.     regionflag=-1:quadrantname quadx,quady
  814.     CALL prtmsg("Now entering "+msg$+" quadrant.")
  815.     klingons=INT(galaxy(quadx,quady)/100)
  816.     starbases=INT(galaxy(quadx,quady)/10)-10*klingons
  817.     stars=galaxy(quadx,quady)-100*klingons-10*starbases
  818.     FOR i=1 TO 8
  819.       FOR j=1 TO 8
  820.         quadrant(i,j)=0
  821.       NEXT
  822.     NEXT
  823.     FOR i=1 TO 3
  824.       klingon(i,3)=0
  825.     NEXT
  826.   END IF
  827.   quadrant(shipx,shipy)=enterprise
  828.   IF klingons>0 THEN
  829.     FOR i=1 TO klingons
  830.       GOSUB findspot
  831.       klingon(i,1)=rnd1
  832.       klingon(i,2)=rnd2
  833.       klingon(i,3)=INT(200*(RND+.5))
  834.       quadrant(rnd1,rnd2)=-1
  835.     NEXT
  836.   END IF
  837.   IF starbases>0 THEN
  838.     GOSUB findspot
  839.     basex=rnd1
  840.     basey=rnd2
  841.     quadrant(basex,basey)=1
  842.   END IF
  843.   FOR i=1 TO stars
  844.     GOSUB findspot
  845.     quadrant(rnd1,rnd2)=2
  846.   NEXT
  847.   IF srsflag THEN GOSUB drawsrs
  848.   RETURN
  849.  
  850. findspot:
  851.   rnd1=INT(8*RND)+1
  852.   rnd2=INT(8*RND)+1
  853.   IF quadrant(rnd1,rnd2)<>0 THEN findspot
  854.   RETURN
  855.  
  856. cle:
  857.   GOSUB drawscreen
  858.   IF srsflag THEN GOSUB drawsrs
  859.   GOTO doinfo
  860. drawscreen:
  861.   COLOR 1,2:CLS
  862.   LINE (0, 8)-(631, 8),1                'communications (top line)
  863.   LINE (0,10)-(631,10),0
  864.   LINE (0,12)-(631,12),1
  865.   COLOR 1,0
  866.   LINE (2,14)-STEP(186,82),1,bf         'readings section
  867.   LINE (4,15)-STEP(182,80),0,bf
  868.   LOCATE  3,2:PRINT "     Stardate:"
  869.   LOCATE  4,2:PRINT "    Time Left:"
  870.   LOCATE  5,2:PRINT "   Bases Left:"
  871.   LOCATE  6,2:PRINT "    Condition:"
  872.   LOCATE  7,2:PRINT "     Quadrant:"
  873.   LOCATE  8,2:PRINT "       Sector:"
  874.   LOCATE  9,2:PRINT " Photon Torps:"
  875.   LOCATE 10,2:PRINT " Total Energy:"
  876.   LOCATE 11,2:PRINT "      Shields:"
  877.   LOCATE 12,2:PRINT "Klingons left:"
  878.   LINE (192,14)-STEP(210,82),1,bf       'control board
  879.   LINE (194,15)-STEP(206,80),2,bf
  880.   COLOR 0,2
  881.   FOR i=2 TO 11
  882.     LINE (197,8*i)-STEP(12,6),0,bf
  883.     LOCATE i+1:PRINT PTAB(214)MID$(command$,3*(i-2)+1,3)
  884.     LINE (241,8*i)-STEP(12,6),0,bf
  885.     LINE (344,8*i)-STEP(11,6),0,bf
  886.     LOCATE i+1:PRINT PTAB(359)"***"
  887.     LINE (386,8*i)-STEP(11,6),0,bf
  888.   NEXT
  889.   LINE (257,16)-STEP(83,3),0,bf         'course info
  890.   LINE (259,17)-STEP(79,1),2,bf
  891.   LINE (257,21)-STEP(83,60),1,bf
  892.   LINE (259,22)-STEP(79,58),0,bf
  893.   LINE (261,23)-STEP(75,56),1,bf
  894.   LINE (257,83)-STEP(83,11),0,bf
  895.   LINE (259,84)-STEP(79,9),2,bf
  896.   LINE (261,85)-STEP(75,7),0,bf
  897.   COLOR 0,1
  898.   LOCATE  4,34:PRINT "    3"
  899.   LOCATE  5,34:PRINT " 4  |  2"
  900.   LOCATE  6,34:PRINT "   \|/"
  901.   LOCATE  7,34:PRINT "5---+---1"
  902.   LOCATE  8,34:PRINT "   /|\"
  903.   LOCATE  9,34:PRINT " 6  |  8"
  904.   LOCATE 10,34:PRINT "    7"
  905.   LINE (406,14)-STEP(223,82),1,bf       'short range scanner
  906.   LINE (408,15)-STEP(219,80),0,bf
  907.   COLOR 1,0
  908.   LOCATE 3,57:PRINT "Short Range Scanner";
  909.   LOCATE 4,56:PRINT "1  2  3  4  5  6  7  8"
  910.   FOR i=1 TO 8:LOCATE i+4,53:PRINT CHR$(48+i):NEXT
  911.   LINE (430,31)-STEP(196,65),1,bf
  912.   LINE (432,32)-STEP(194,63),0,bf
  913.   LINE (2,98)-STEP(627,2),1,bf          'top/bottom dividing line
  914.   LINE (4,99)-STEP(623,0),0
  915.   LINE (2,186)-STEP(627,0),1
  916.   LINE (2,102)-STEP(186,82),1,bf        'long range scanner
  917.   LINE (4,103)-STEP(182,80),0,bf
  918.   LOCATE 14,4:PRINT "Long Range Scanner"
  919.   FOR i=112 TO 118 STEP 3:LINE (4,i)-STEP(182,0),1,b:NEXT
  920.   LINE (192,102)-STEP(210,10),1,bf      'command
  921.   LINE (194,103)-STEP(206,8),0,bf
  922.   LINE (192,114)-STEP(210,2),1,bf
  923.   LINE (194,115)-STEP(206,0),0
  924.   LINE (192,118)-STEP(210,18),1,bf      'shield control
  925.   LINE (194,119)-STEP(206,16),0,bf
  926.   LOCATE 16,31:PRINT "Shield Control"
  927.   LINE (192,138)-STEP(437,2),1,bf
  928.   LINE (194,139)-STEP(433,0),0
  929.   LINE (192,142)-STEP(210,18),1,bf      'phasers
  930.   LINE (194,143)-STEP(206,16),0,bf
  931.   LOCATE 19,31:PRINT "Phaser Station"
  932.   LINE (192,162)-STEP(210,2),1,bf
  933.   LINE (194,163)-STEP(206,0),0
  934.   LINE (192,166)-STEP(210,18),1,bf      'photon torpedos
  935.   LINE (194,167)-STEP(206,16),0,bf
  936.   LOCATE 22,27:PRINT "Photon Torpedo Station"
  937.   LINE (406,102)-STEP(223,34),1,bf      'navigation
  938.   LINE (408,103)-STEP(219,32),0,bf
  939.   LOCATE 14,57:PRINT "Navigation Station"
  940.   FOR i=112 TO 118 STEP 3:LINE (408,i)-STEP(221,0),1,b:NEXT
  941.   LINE (406,142)-STEP(223,42),1,bf      'damage control
  942.   LINE (408,143)-STEP(219,40),0,bf
  943.   LOCATE 19,55:PRINT "Damage Control Station"
  944.   srsflag=0
  945.   RETURN
  946.  
  947. redalert:
  948.   FOR i=1 TO 4
  949.     FOR freq=1000 TO 2000 STEP 40
  950.       SOUND freq,.5,255
  951.     NEXT
  952.   NEXT
  953.   RETURN
  954.  
  955. torpedosnd:
  956.   FOR freq=1500 TO 500 STEP -40
  957.     SOUND freq,1,255
  958.     SOUND 3600-freq,1,255
  959.   NEXT
  960.   RETURN
  961.  
  962. phasersnd:
  963.   FOR i=1 TO 10
  964.     SOUND 800,1,255
  965.     SOUND 2500,1,255
  966.   NEXT
  967.   RETURN
  968.  
  969. alarmsnd:
  970.   FOR j=1 TO 6
  971.     FOR freq=1 TO 15
  972.       SOUND 150-freq,1,255,2
  973.       SOUND 200+freq,1,255,3
  974.     NEXT
  975.   NEXT
  976.   RETURN
  977.  
  978. intro1:
  979.   RESTORE intro1
  980.   CALL zoom(0,0,631,186,1)
  981.   CALL zoom(0,4,631,186,2)
  982.   COLOR 1,2:LOCATE 2,15:PRINT "These are the voyages of the Starship Enterprise..."
  983.   FOR i=1 TO 8
  984.     READ freq,duration,volume
  985.     SOUND freq,duration,volume,0
  986.     SOUND freq,duration,volume,1
  987.   NEXT
  988.   RETURN
  989. DATA 1568,3,255,1568,25,175,784,3,255,784,25,175
  990. DATA 1175,3,255,1175,25,175,587,3,255,587,75,150
  991.  
  992. intro2:
  993.   CALL zoom(0,20,631,186,3)
  994.   CALL zoom(0,36,631,186,2)
  995.   COLOR 2,3
  996.   LOCATE 4,15:PRINT "Current mission, to save Federation Headquarters..."
  997.   RETURN
  998.  
  999. intro3:
  1000.   RESTORE intro3
  1001.   CALL zoom(0,40,631,186,1)
  1002.   CALL zoom(4,44,627,186,0)
  1003.   COLOR 2,0
  1004.   IF totalbases=1 THEN plural$="" ELSE plural$="s"
  1005.   LOCATE 7,17:PRINT "Which will be attacked by";totalklingons;"Klingon warships"
  1006.   LOCATE 8,10:PRINT "that have invaded the galaxy.  You have until Stardate";startdate+enddate
  1007.   LOCATE 9,10:PRINT "before they attack.  This gives you";enddate;"days to complete your"
  1008.   LOCATE 10,15:PRINT "mission.  You will have";totalbases;"starbase";plural$;" in the galaxy"
  1009.   LOCATE 11,21:PRINT "for resupply and repair of your ship."
  1010.   OPEN "ent" FOR INPUT AS #2
  1011.     OBJECT.SHAPE 1,INPUT$(LOF(2),2)
  1012.   CLOSE #2
  1013.   OBJECT.X 1,608    '560
  1014.   OBJECT.Y 1,140
  1015.   OBJECT.VX 1,-.1
  1016.   OBJECT.AX 1,-1.5
  1017.   ON COLLISION GOSUB offscreen:COLLISION ON
  1018.   CALL zoom(0,92,631,186,1)
  1019.   CALL zoom(0,96,631,186,2)
  1020.   FOR i=1 TO 50
  1021.     PUT (24*INT((631*RND)/24),8*INT((88*RND)/8)+97),star,PSET
  1022.   NEXT
  1023.   OBJECT.ON 1
  1024.   OBJECT.START 1
  1025.   volume=255
  1026.   FOR i=1 TO 9
  1027.     READ freq,duration
  1028.     FOR j=0 TO 3
  1029.       SOUND freq,duration,volume,j
  1030.     NEXT
  1031.   NEXT
  1032.   SOUND 466,4,255,0
  1033.   SOUND 277,4,255,1
  1034.   SOUND 622,4,255,2
  1035.   SOUND 370,4,255,3
  1036.   SOUND 466,64,255,0
  1037.   SOUND 233,64,255,1
  1038.   SOUND 698,64,255,2
  1039.   SOUND 349,64,255,3
  1040.   CALL delay(10)
  1041.   RETURN
  1042. DATA 262,12,349,4,466,24,440,8,392,8,349,8,311,12,416,4,555,52
  1043.  
  1044. offscreen:
  1045.   COLLISION OFF
  1046.   OBJECT.OFF
  1047.   RETURN
  1048.  
  1049. winner:
  1050.   CALL prtmsg("Message from STARFLEET COMMAND:"):delay 3
  1051.   CALL prtmsg("Congratulations, Captain!"):delay 3
  1052.   CALL prtmsg("The last Klingon battle cruiser menacing the Federation has been destroyed!"):delay 3
  1053.   CALL prtmsg("Your efficiency rating is"+STR$(1000*(numshot/(thisdate!-startdate))^2)):delay 3
  1054. newgame:
  1055.   CALL prtmsg("This is the record of the Galaxy at the end of your mission.")
  1056.   GOSUB gal:whoa:WINDOW CLOSE 3
  1057.   IF totalbases>0 THEN
  1058.     CALL prtmsg("The Federation is in need of a new starship commander for a similar mission."):delay 3
  1059.     CALL prtmsg("If there is a volunteer, let him or her now step forward."):delay 3
  1060.     CALL prtmsg("Enter `Y' to volunteer, or `N' to retire.")
  1061.     key$="":WHILE key$<>"Y" AND key$<>"N":key$=UCASE$(INKEY$):SLEEP:WEND
  1062.     IF key$="N" THEN quit
  1063.   END IF
  1064.   IF NOT debug THEN GOSUB intro1
  1065.   GOTO begin
  1066.  
  1067. quit:
  1068.   OBJECT.CLOSE
  1069.   IF rgb(2,1)<>0 THEN
  1070.     FOR i=0 TO 3
  1071.       PALETTE i,rgb(i+1,1),rgb(i+1,2),rgb(i+1,3)
  1072.     NEXT
  1073.   END IF
  1074.   MENU RESET
  1075.   IF NOT debug THEN
  1076.     FOR freq=1200 TO 100 STEP -10
  1077.       SOUND freq,.3,255,0:SOUND 1.25*freq,.3,255,1
  1078.     NEXT
  1079.     WINDOW 9,,(236,89)-(236+160,89+7),0
  1080.     COLOR 3,2:CLS:PRINT "    john everett":PRINT "PeopleLINK ID OHS303";
  1081.     SOUND  200,50,255,0:SOUND  250,50,255,1
  1082.     SOUND  300,50,255,2:SOUND  400,50,255,3
  1083.   END IF
  1084.   WINDOW CLOSE 2
  1085.   CALL delay(3)
  1086.   WINDOW CLOSE 9
  1087.   WINDOW 1
  1088.   COLOR 3,2:CLS
  1089.   PRINT "You ";:COLOR 1:PRINT "MUST";
  1090.   COLOR 3:PRINT " click the ";:COLOR 1:PRINT "NO"
  1091.   COLOR 3:PRINT "gadget when the next":PRINT "requestor is presented,"
  1092.   PRINT "as most of the program":PRINT "will have been erased"
  1093.   PRINT "in order to release":PRINT "it's extra memory!";:delay 5
  1094. zx:
  1095.   DELETE begin-quit
  1096.   CLEAR,25000
  1097.   SOUND 1600,1,255,0:SOUND 2000,1,255,1
  1098.   SOUND  100,2,255,0:SOUND  125,2,255,1
  1099.   SYSTEM
  1100.   END
  1101.  
  1102. SUB whoa STATIC
  1103.   WHILE INKEY$="":SLEEP:WEND
  1104. END SUB
  1105.  
  1106. SUB delay(amount) STATIC
  1107.   late!=TIMER+CSNG(amount)
  1108.   WHILE MOUSE(0)<>0:WEND
  1109.   WHILE TIMER<late! AND MOUSE(0)=0:WEND
  1110. END SUB
  1111.  
  1112. SUB stall STATIC
  1113.   FOR i=1 TO 400:NEXT
  1114. END SUB
  1115.  
  1116. SUB ding STATIC
  1117.   SOUND 3000,2,255,3
  1118.   SOUND 1500,6,255,1
  1119. END SUB
  1120.  
  1121. SUB prtmsg(msg$) STATIC
  1122.   CALL ding:dissolve
  1123.   COLOR 3,2:LOCATE 1,1:PRINT TAB((80-LEN(msg$))/2)msg$
  1124. END SUB
  1125.  
  1126. SUB dissolve STATIC
  1127.   FOR colr=1 TO 2
  1128.     FOR j=0 TO 15 STEP 4
  1129.       FOR i=0 TO 40
  1130.         LINE (16*i+j,0)-STEP(3,7),colr,bf
  1131.       NEXT
  1132.     NEXT
  1133.   NEXT
  1134. END SUB
  1135.  
  1136. SUB zoom(sx,sy,ex,ey,colr) STATIC
  1137.   FOR i=(ey-sy)/2 TO 0 STEP -1
  1138.     LINE (sx+i,sy+i)-(ex-i,ey-i),colr,b
  1139.   NEXT
  1140. END SUB
  1141.  
  1142. SUB navnum(x,y,number!) STATIC
  1143.   COLOR 3,2
  1144.   msg$=""
  1145. digiloop:
  1146.   key$="":i=0
  1147.   WHILE i=0
  1148.     key$=INKEY$
  1149.     i=INSTR("1234567890."+CHR$(13)+CHR$(8),key$)
  1150.     SLEEP
  1151.   WEND
  1152.   IF i=13 THEN
  1153.     IF LEN(msg$)>0 THEN msg$=LEFT$(msg$,LEN(msg$)-1)
  1154.     LOCATE y,x:PRINT RIGHT$("____"+msg$,4);
  1155.     GOTO digiloop
  1156.   ELSEIF i<12 THEN
  1157.     msg$=msg$+key$
  1158.     LOCATE y,x:PRINT RIGHT$("____"+msg$,4);
  1159.     IF LEN(msg$)<4 THEN digiloop
  1160.   END IF
  1161.   number!=VAL(msg$)
  1162. END SUB
  1163.  
  1164. SUB blast(x,y) STATIC
  1165.   SHARED bng1(),bng2(),bng3(),boom()
  1166.   WAVE 0,boom
  1167.   PUT (x,y),bng1,PSET
  1168.   FOR freq=70 TO 120:SOUND freq,.1,255,0:NEXT
  1169.   PUT (x,y),bng2,PSET
  1170.   FOR freq=120 TO 170:SOUND 300-freq,.1,255,0:NEXT
  1171.   PUT (x,y),bng3,PSET
  1172.   SOUND 300-freq,3,255,0:stall
  1173.   LINE (x,y)-STEP(23,7),2,bf
  1174.   WAVE 0,SIN
  1175. END SUB
  1176.  
  1177. SUB quadrantname(x,y) STATIC
  1178.   SHARED quad1$,quad2$,msg$,regionflag
  1179.   IF x<4 THEN
  1180.     msg$=MID$(quad1$,11*(y-1)+1,11)
  1181.   ELSE
  1182.     msg$=MID$(quad2$,10*(y-1)+1,10)
  1183.   END IF
  1184.   CALL nospaces(msg$)
  1185.   IF regionflag THEN
  1186.     msg$=msg$+MID$(" I   II  III IV  I   II  III IV ",4*(x-1)+1,4)
  1187.     CALL nospaces(msg$)
  1188.   END IF
  1189. END SUB
  1190.  
  1191. SUB nospaces(msg$) STATIC
  1192.   WHILE RIGHT$(msg$,1)=" ":msg$=LEFT$(msg$,LEN(msg$)-1):WEND
  1193. END SUB
  1194.  
  1195. SUB digit(i) STATIC
  1196.   key$="":WHILE key$<"1" OR key$>"8":key$=INKEY$:SLEEP:WEND
  1197.   i=VAL(key$)
  1198. END SUB
  1199.  
  1200. SUB getcourse(sx,sy,ex,ey) STATIC
  1201.   SHARED course!,x!
  1202.   dy=ey-sy
  1203.   dx=ex-sx
  1204.   IF dy<0 THEN c
  1205.   IF dx<0 THEN d
  1206.   IF dy>0 THEN a
  1207.   IF dx=0 THEN course!=3:GOTO b
  1208. a:
  1209.   course!=7
  1210. b:
  1211.   dx=ABS(dx):dy=ABS(dy)
  1212.   IF dx>dy THEN
  1213.     course!=course!+(2*dx-dy)/dx
  1214.   ELSE
  1215.     course!=course!+(dx/dy)
  1216.   END IF
  1217.   GOTO out
  1218. c:
  1219.   IF dx>0 THEN course!=1:GOTO e
  1220.   IF dy<>0 THEN course!=3:GOTO b
  1221. d:
  1222.   course!=5
  1223. e:
  1224.   dx=ABS(dx):dy=ABS(dy)
  1225.   IF dx<dy THEN
  1226.     course!=course!+(2*dy-dx)/dy
  1227.   ELSE
  1228.     course!=course!+(dy/dx)
  1229.   END IF
  1230. out:
  1231.   IF course!=9 THEN course!=1
  1232.   x!=SQR(dy^2+dx^2)
  1233. END SUB
  1234.  
  1235. DATA "Warp Engines","ShortRange Sensor","Long Range Sensor","Phaser Control"
  1236. DATA "Photon Tubes","Damage Control","Shield Control","Library/Computer"
  1237.